perm filename TAK2.LSP[F78,JMC] blob
sn#384957 filedate 1978-10-02 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (defun qtak (u) (cond ((numberp u) u) ((equal (car u) 1) (cadr u))
C00003 ENDMK
Cā;
(defun qtak (u) (cond ((numberp u) u) ((equal (car u) 1) (cadr u))
(t ((lambda (w) ((lambda (x y z) (cond ((not (lessp y x)) y)
(t (qtak (list 2 (list 2 (list 1 (sub1 x)) (list 1 y) z)
(list 2 (list 1 (sub1 y)) z (list 1 x))
(list 3 (list 1 x) (list 1 y) z))))))
(car w) (cadr w) (caddr w))) (cond ((equal (car u) 2)
(list (qtak (cadr u)) (qtak (caddr u)) (cadddr u)))
(t (list (sub1 (qtak (cadddr u))) (qtak (cadadr u)) (caddr u))))))))